perm filename FILLXG.FAI[NEW,LCS] blob
sn#231778 filedate 1977-03-21 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00002 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 TITLE FILL
C00018 ENDMK
C⊗;
TITLE FILL
ENTRY FILLER,LINES,PLOTS,NOIR
EXTERNAL DST,PLTR,DPY,.COMM.,ROFF,XRN,SQRT,PLOT
;; DEFINE FLOAT(N)
;; < TLC N,232000
;; FADR N,N >
DEFINE FIXX(N)
< KIFIX N,N ↔ >
KK←2 ↔ L←3 ↔ LE←4 ↔ T←5 ↔ J←1
RL←6 ↔ RJ←7 ↔ B←0 ↔ H←11 ↔ JK←10
HG←12 ↔ D←13 ↔ AL←14 ↔ JJ←15
; SUBROUTINE FILLER(Q,M)
FILLER: 0
MOVEM 16,SV16#
HRRZ J,(16)
HRRZM J,SVQ#
HRRZ T,@1(16)
HRRZM T,SVM# ; KK=NE(1)
HRRZ KK,2(J)
ADDI KK,-1(J)
; DO 4 K=2,KK
HRRZI L,2(J)
; IF(NE(K).NE.3)GO TO 11
L4: ADDI L,3
HRRZ T,(L)
L11: SETZM (L)
CAIN T,3
; NE(K)=-1
SETOM (L)
; GO TO 4
; 11 NE(K)=0
; 4 CONTINUE
CAIGE L,(KK)
JRST L4
; RLFT=10000
MOVE RL,[=10000.0]
; RT=-10000
MOVN RJ,[=10000.0]
; B=RT
MOVE B,RJ
; DO 12 K=1,KK
HRRZI L,-3(J)
; H=IFIX(Q(K))
L12: ADDI L,3
MOVE H,(L)
FIXX(H)
FLTR H,H ;KL10 FLOAT
; IF(H.LT.RLFT)RLFT=H
CAMGE H,RL
MOVE RL,H
; IF(H.GT.RT)RT=H
CAMLE H,RJ
MOVE RJ,H
; IF(H.EQ.B)NE(K)=-1
CAMN H,B
SETOM 2(L)
; B=H
MOVE B,H
; Q(K)=H
MOVEM H,(L)
; 12 R(K)=IFIX(R(K))
MOVE T,1(L)
FIXX(T)
FLTR T,T ;FLOAT
MOVEM T,1(L)
CAIGE L,-2(KK)
JRST L12
; NE(KK+1)=-1
SETOM 3(KK)
; LRT=RT
FIXX(RJ)
MOVEM RJ,LRT#
; JA=3
HRRZI T,3
HRRZM T,JA#
; 124 LEFT=RLFT
L124: MOVE LE,RL
FIXX(LE)
; 51 J=LEFT
L51: MOVE J,LE
; 42 RJ=J+.001
;;L42: MOVE RJ,J
L42: FLTR RJ,J ;FLOAT J, PUT IT IN RJ
FADR RJ,[=0.001]
; JCONT=0
SETZM JCONT#
; LEFT=J
MOVE LE,J
; JJ=-1
SETO JJ,
; ALT=-10000.
MOVN AL,[=10000.0]
; 200 DO 45 L=2,KK
HRRZ L,SVQ
L45: ADDI L,3
CAILE L,-2(KK)
JRST L455
; IF(NE(L).NE.0)GO TO 45
SKIPE 2(L)
JRST L45
; IF(MISS(L,RJ,Q))GO TO 45
CAML RJ,-3(L)
JRST L201
CAMLE RJ,(L)
JRST L202
L201: CAMGE RJ,(L)
CAMG RJ,-3(L)
JRST L45
; H=HGHT(L,RJ,Q,R)
L202: MOVE H,-2(L)
CAMN H,1(L)
JRST RET
MOVNS H
FADR H,1(L)
MOVE D,-3(L)
MOVNS T,D
FADR T,RJ
FADR D,(L)
FMPR H,T
FDVR H,D
FADR H,-2(L)
; IF(H.LT.ALT)GO TO 45
RET: CAMGE H,AL
JRST L45
; ALT=H
MOVE AL,H
; JJ=L
HRRZI JJ,(L)
; 45 CONTINUE
JRST L45
; IF(JJ)GO TO 43
L455: JUMPL JJ,L43
; JCONT=-1
SETOM JCONT
; LEFT=J
MOVE LE,J
; 46 JA=3
L46: HRRZI T,3
HRRZM T,JA
; JORD=-1
SETOM JORD#
; 52 KN=Q(JJ)
L52: MOVE T,(JJ)
FIXX(T)
MOVEM T,KN#
; KL=Q(JJ-1)
MOVE T,-3(JJ)
FIXX(T)
MOVEM T,KL#
; IF(KN.LT.KL)KN=KL
CAMLE T,KN
MOVEM T,KN
; 50 I=J
L50: MOVEM J,I#
; 102 RJ=I+.01
;;L102: MOVE RJ,I
L102: FLTR RJ,I ;FLOAT I, PUT IT IN RJ
FADR RJ,[=0.1] ;6/11/75 ←←**↑↑ WAS 0.01 -- CHECK TIGHT CASES!!
; ALT=HGHT(JJ,RJ,Q,R)
MOVE AL,-2(JJ)
CAMN AL,1(JJ)
JRST RET2
MOVNS AL
FADR AL,1(JJ)
MOVE D,-3(JJ)
MOVNS T,D
FADR T,RJ
FADR D,(JJ)
FMPR AL,T
FDVR AL,D
FADR AL,-2(JJ)
; B=-10000
RET2: MOVN B,[=10000.0]
; JK=-1
SETO JK,
; XALT=ALT+.001
MOVE T,AL
FADR T,[=0.001]
MOVEM T,XALT#
; ZALT=ALT
MOVEM AL,ZALT#
; 400 DO 47 L=2,KK
MOVE L,SVQ
L47: ADDI L,3
CAILE L,-2(KK)
JRST L477
; IF(L.EQ.JJ.OR.MISS(L,RJ,Q).OR.NE(L).LT.0)GO TO 47
CAME L,JJ
SKIPGE 2(L)
JRST L47
CAML RJ,-3(L)
JRST L475
CAMLE RJ,(L)
JRST L476
L475: CAMGE RJ,(L)
CAMG RJ,-3(L)
JRST L47
; H=HGHT(L,RJ,Q,R)
L476: MOVE H,-2(L)
CAMN H,1(L)
JRST RET3
MOVNS H
FADR H,1(L)
MOVE D,-3(L)
MOVNS T,D
FADR T,RJ
FADR D,(L)
FMPR H,T
FDVR H,D
FADR H,-2(L)
; IF(H.GT.XALT)GO TO 47
RET3: CAMG H,XALT
; IF(H.LE.B)GO TO 47
CAMG H,B
JRST L47
; B=H
MOVE B,H
; JK=L
HRRZI JK,(L)
; 47 CONTINUE
JRST L47
; IF(JK)GO TO 48
L477: JUMPL JK,L48
; 300 IF(ZALT-B.GT..001.OR.I.NE.J)GO TO 59
MOVN T,B
FADR T,ZALT
CAMG T,[=0.001]
CAME J,I
JRST L59
; JX=Q(JK)
MOVE T,(JK)
FIXX(T)
; IF(JX.GT.KN)GO TO 60
CAMLE T,KN
JRST L60
; JX=Q(JK-1)
MOVE T,-3(JK)
FIXX(T)
; IF(JX.LT.KN)GO TO 59
CAMGE T,KN
JRST L59
; 60 L=JJ
L60: MOVE L,JJ
; JJ=JK
MOVE JJ,JK
; JK=L
MOVE JK,L
; KN=JX
MOVEM T,KN
; 59 IF(ALT-B.LT.2)GO TO 62
L59: MOVN T,B
FADR T,AL
CAMGE T,[=2.0]
JRST L62
; ALT=ALT-1
HRLZI T,576400
FADR AL,T
; B=B+1
HRLZI T,201400
FADR B,T
; 62 IF(JORD)GO TO 103
L62: SKIPGE JORD
JRST L103
; H=B
MOVE H,B
; B=ALT
MOVE B,AL
; ALT=H
MOVE AL,H
; IF(JK.NE.NK.AND.ABS(ALT-B).GT.5.)JA=3
CAMN JK,NK#
JRST L103
MOVN T,B
FADR T,AL
SKIPGE T
MOVNS T
CAMG T,[5.0]
JRST L103
HRRZI T,3
HRRZM T,JA
; 103 CALL LINES(RJ,ALT,JA)
L103: MOVEM RJ,SVRJ#
MOVEM AL,SVAL#
MOVEM B,SVB#
HRRZI 16,SVAC
BLT 16,SVAC+15
JSA 16,LINES
JUMP SVRJ
JUMP SVAL
JUMP JA
; 100 CALL LINES(RJ,B,2)
JSA 16,LINES
JUMP SVRJ
JUMP SVB
JUMP [2]
HRLZI 16,SVAC
BLT 16,15
; NK=JK
MOVEM JK,NK
; JORD=-JORD
MOVNS JORD
; NE(JK)=1
HRRZI T,1
HRRZM T,2(JK)
; NE(JJ)=-1
SETOM 2(JJ)
; JA=2
HRRZI T,2
HRRZM T,JA
; I=I+M
MOVE T,SVM
ADDB T,I
; IF(I.LT.KN)GO TO 102
CAMGE T,KN
JRST L102
; L=1
HRRZI L,3
; IF(KN.EQ.KL)L=-1
MOVE T,KN
CAMN T,KL
HRROI L,-3
; JJ=JJ+L
ADD JJ,L
; J=0
SETZ J,
; IF(L)J=-1
SKIPGE L
HRROI J,-3
; IF(KN+M.GT.Q(JJ+J).OR.JJ.GT.KK.OR.NE(JJ).NE.0)GO TO 124
SKIPN 2(JJ)
CAILE JJ,-2(KK)
JRST L124
ADD T,SVM
FLTR T,T
HRRZI HG,(JJ)
ADD HG,J
CAMLE T,(HG)
JRST L124
; J=I
MOVE J,I
; GO TO 52
JRST L52
; 48 JA=3
L48: HRRZI T,3
HRRZM T,JA
; 43 J=LEFT+M
L43: MOVE J,LE
ADD J,SVM
; IF(J.LE.LRT)GO TO 42
CAMG J,LRT
JRST L42
; IF(JCONT)GO TO 51
SKIPGE JCONT
JRST L51 ; END
MOVE 16,SV16
JRA 16,2(16)
SVAC: BLOCK 16
; SUBROUTINE LINES(A,B,L)
; COMMON/DST/BB,CC
; COMMON /SIZ/RSZ,JCEN,KCEN /FL/IC,NZ,NX,RZ,XGP
; COMMON/DL/IXRX,SAVER,AA /PLTR/IPLT,RHT,DIS
; COMMON R2,JA,CENTR,JB,RJQ(20),JQ(20)
; COMMON/DPY/JJ(4000),WDS(250),MEDIT,IGO
; EQUIVALENCE (ITOP,JJ(3999)),(IBOT,JJ(4000))
; 1,(JJ2,JJ(2))
; DATA BB/.008/,CC/3.5/
;C SET XGP TO 1200.0 FOR MARGIN IN XEROX COPIES
M←2 ↔ NZ←3 ↔ K←4
LINES: 0
; GO TO 23
JRST L23
;22 IF(JQ(1).NE.0)GO TO 23
L22: SKIPE PLTR+=27
JRST L23
; IF(CC.EQ.1000)GO TO 23
MOVSI T,212764
CAMN T,DST+1
JRST L23
; B=B*(CC-BB*ABS(A))
MOVE T,@(16)
MOVMS T
FMPR T,DST
FSBR T,DST+1
FMPRM T,@1(16)
MOVNS @1(16)
;23 IF(IPLT)GO TO 2
L23: SKIPGE PLTR
;; JRST L2
JRST L9
MOVE T,.COMM.+1 ;IF(JA.EQ.44)RETURN
CAIN T,=44 ;WON'T LOOK AT BARLINES FOR HEIGHT.
JRA 16,3(16)
MOVE T,@1(16)
CAMG T,DPY+1
JRST L333
MOVEM T,DPY+1 ; IF(B.LT.BOT)BOT=B
JRA 16,3(16)
L333: CAMG T,DPY+2
MOVEM T,DPY+2
JRA 16,3(16) ; IF(B.GT.TOP)TOP=B
;2 IF(IPLT.EQ.-2)RETURN
;;L2: MOVNI T,2
;; CAMN T,PLTR
;; JRA 16,3(16)
;9 M=ROFF(A*DIS)
L9: MOVE M,@(16)
FMPR M,PLTR+2
SKIPGE M
FADR M,[-=1.0]
FADR M,[=0.5]
FIXX(M)
MOVEM M,MM#
; N=ROFF(B*RHT)
MOVE NZ,@1(16)
FMPR NZ,PLTR+1
SKIPGE NZ
FADR NZ,[-=1.0]
FADR NZ,[=0.5]
FIXX(NZ)
MOVEM NZ,NN#
;8 CALL PLOT(M,N,L)
L8: MOVE T,@2(16)
MOVEM T,LL#
JSA 16,PLOT
JUMP MM
JUMP NN
JUMP LL
; END
JRA 16,3(16)
PLOTS: 0
JRA 16,1(16) ; DUMMY ROUTINE
J←10↔ A←2↔ B←3↔ C←4↔ D←5↔ E←6↔ NQ←11↔NX←12 ; SUBROUTINE NOIR(RMINI)
Y←13↔ X←14↔ L←15↔ M←1
JPOS: 0 ;C BLACKS IN NOTES
IPOS: 0 ;COMMON R2,JA,CENTR,J2,RJQ(20),JQ(12),B,C,KC,D,N,JY,M,L
IC: 0
KZ: 0
NOIR: 0 ; COMMON/PLTR/IPLT,RHT,DIS /XRN/IRN(4000)
MOVE A,.COMM.+4 ;EQUIVALENCE (PRE,IRN(1))
FMPR A,PLTR+2 ;DATA BL/7.5/,BH/6.7/
; ADJUST BH AND FL FOR HEIGHT OF NOTE AND 'WIDTH'
JSA 16,ROFF ;IPOS=ROFF(RJQ(1)*DIS)
JUMP A
FIXX(A)
MOVEM A,IPOS
MOVE A,.COMM.+2 ;JPOS=ROFF(CENTR*RHT)
FMPR A,PLTR+1
JSA 16,ROFF
JUMP A
FIXX(A)
;?? MOVE D,@(16)
;?? CAME D,STF+8 ;IF(RMINI.NE.RSTJ2)JPOS=JPOS+1
;?? AOS A ;TO PUSH MINI-NOTE UP ONE XGP NOTCH!!!! *******************
MOVEM A,JPOS ;SAVE FOR LATER
MOVN A,@(16) ;IF(-RMINI.EQ.PRE)GO TO 10
CAMN A,XRN
JRST NO10
MOVEM A,XRN ;PRE=-RMINI
MOVE D,[=0.25] ;D=.25
MOVE B,[=6.7] ;B=BH*RMINI*RHT
FMPR B,PLTR+1
FMPR B,@(16)
MOVE E,PLTR+2 ;E=RMINI*DIS
FMPR E,@(16)
MOVE A,[=7.5] ;A=BL*E
FMPR A,E
MOVE 15,A
FIXX(15) ;IC=A
MOVEM 15,IC
FMPR A,A ;A=A*A
MOVN E,B ;E=-B/4.
FDVR E,[=4.0]
MOVE 15,B ;K=B
FIXX(15)
MOVEM 15,KZ
FMPR B,B ;B=B*B
; USES EQUATION FOR ELLIPSE
MOVEI 11,1 ;N=1
MOVEI NX,2 ;NX=2
MOVN J,KZ ;6 DO 1 J=-K,K
NO1: MOVE Y,J ;Y=J*J
IMUL Y,Y
FLTR Y,Y ;FLOAT
MOVNS Y ;X=SQRT(A-(A*Y)/B)
FMPR Y,A
FDVR Y,B
FADR Y,A
JSA 16,SQRT
JUMP Y
MOVE L,E ;L=E-X
FSBR L,0
FIXX(L)
;; MOVE M,X ;M=X+E
;; FADR M,E
FADR 0,E
FIXX(0) ; THE TWO SIDES OF THE LINE
SKIPGE 11 ;IF(N)CALL EXCH(L,M)
EXCH L,0
MOVEM L,XRN-1(NX)
MOVEM 0,XRN(NX) ; C IS VERTICLE POS.
ADDI NX,2 ;NX=NX+2
FADR E,D ;E=E+D E IS TO TILT IT.
MOVNS 11 ;1 N=-N
CAMGE J,KZ
AOJA J,NO1 ;LOOP BACK
NO10: MOVE J,IPOS ;10 CALL PLOT(IPOS+3,JPOS,3)
ADDI J,3
JSA 16,PLOT
JUMP J
JUMP JPOS
JUMP [3]
MOVEI 11,2 ;N=2 1ST LOC. OF ARRAY HAS "PRE"
MOVE L,IC ;L=IPOS+IC
ADD L,IPOS
MOVN M,KZ ;DO 11 M=-K,K
NO11: MOVE J,JPOS ;J=M+JPOS
MOVEM M,PLOTS
ADD J,M ;CALL PLOT(L+IRN(N),J,2)
MOVE NX,XRN-1(11)
ADD NX,L
JSA 16,PLOT
JUMP NX
JUMP J
JUMP [2] ;CALL PLOT(L+IRN(N+1),J,2)
MOVE NX,XRN(11)
ADD NX,L
JSA 16,PLOT
JUMP NX
JUMP J
JUMP [2]
ADDI 11,2 ;11 N=N+2
MOVE M,PLOTS
CAMGE M,KZ
AOJA M,NO11
JRA 16,1(16)
END